home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / contrib / weak-refs / weak.c < prev   
Encoding:
C/C++ Source or Header  |  1992-11-08  |  2.9 KB  |  127 lines
  1. #include <scheme.h>
  2.  
  3. /*  weak.c defines a type "weak-reference" with operations
  4.     (cons-weak-ref [default [initial]])
  5.     -- if initial is omitted, it is the same as default
  6.     -- if default is omitted, it is #F
  7.     (weak-ref? object)
  8.     (weak-contents weak-ref)
  9.     -- returns the current value of the weak-ref
  10.     (weak-default weak-ref)
  11.     -- returns the default value of the object
  12.     (weak-set-contents! weak-ref value)
  13.     -- updates the current value of the object
  14.     (weak-set-default! weak-ref value)
  15.     -- updates the default value of the object
  16.     A weak reference is just like a pair except that when a garbage
  17.     collection occurs, the current value is replaced by the default
  18.     value.  The point of this is to let you define "pools".
  19. */
  20.  
  21. static int T_Weak;
  22.  
  23. #define WEAK(x)   ((struct S_Weak *)POINTER(x))
  24.  
  25. struct S_Weak {
  26.     Object defalt;
  27.     Object curval;
  28. };
  29.  
  30. static Object P_Weak_Cons(argc, argv)
  31.     int argc;
  32.     Object *argv;
  33.     {
  34.     Object defalt = argc < 1 ? False : argv[0];
  35.     Object curval = argc < 2 ? defalt : argv[1];
  36.     Object h;
  37.     GC_Node2;
  38.  
  39.     GC_Link2(defalt, curval);
  40.     h = Alloc_Object(sizeof (struct S_Weak), T_Weak, 0);
  41.     WEAK(h)->defalt = defalt;
  42.     WEAK(h)->curval = curval;
  43.     GC_Unlink;
  44.     return h;
  45.     }
  46.  
  47. static Object P_Weakp(x)
  48.     Object x;
  49.     {
  50.     return TYPE(x) == T_Weak ? True : False;
  51.     }
  52.  
  53. static Object P_Weak_Contents(h)
  54.     Object h;
  55.     {
  56.     Check_Type(h, T_Weak);
  57.     return WEAK(h)->curval;
  58.     }
  59.  
  60. static Object P_Weak_Default(h)
  61.     Object h;
  62.     {
  63.     Check_Type(h, T_Weak);
  64.     return WEAK(h)->defalt;
  65.     }
  66.  
  67. static Object P_Weak_Set_Cont(h, val)
  68.     Object h, val;
  69.     {
  70.     Check_Type(h, T_Weak);
  71.     WEAK(h)->curval = val;
  72.     return h;
  73.     }
  74.  
  75. static Object P_Weak_Set_Dflt(h, val)
  76.     Object h, val;
  77.     {
  78.     Check_Type(h, T_Weak);
  79.     WEAK(h)->defalt = val;
  80.     return h;
  81.     }
  82.  
  83.  
  84. static int Weak_Eqv(a, b)
  85.     Object a, b;
  86.     {
  87.     return EQ(a, b);
  88.     }
  89.  
  90. static int Weak_Equal(a, b)
  91.     Object a, b;
  92.     {
  93.     return    Equal(WEAK(a)->defalt, WEAK(b)->defalt)  &&
  94.         Equal(WEAK(a)->curval, WEAK(b)->curval);
  95.     }
  96.  
  97. static Weak_Print(h, port, raw, depth, length)
  98.     Object h, port;
  99.     int raw, depth, length;
  100.     {
  101.     Printf(port, "#[hunk3 %u: ", POINTER(h));
  102.     Print_Object(WEAK(h)->defalt, port, raw, depth-1, length);
  103.     Printf(port, "]");
  104.     }
  105.  
  106. static Weak_Visit(hp, f)
  107.     Object *hp;
  108.     int (*f)();
  109.     {
  110.     struct S_Weak *p = WEAK(*hp);
  111.     p->curval = p->defalt;
  112.     (*f)(&(p->defalt));
  113.     }
  114.  
  115. init_lib_weak()
  116.     {
  117.     T_Weak = Define_Type(0, "weak-ref", NOFUNC, sizeof (struct S_Weak),
  118.                  Weak_Eqv, Weak_Equal, Weak_Print, Weak_Visit);
  119.     Define_Primitive(P_Weak_Cons,      "cons-weak-ref",      0, 2, VARARGS);
  120.     Define_Primitive(P_Weakp,      "weak-ref?",            1, 1, EVAL);
  121.     Define_Primitive(P_Weak_Contents, "weak-contents",      1, 1, EVAL);
  122.     Define_Primitive(P_Weak_Default,  "weak-default",       1, 1, EVAL);
  123.     Define_Primitive(P_Weak_Set_Cont, "weak-set-contents!", 2, 2, EVAL);
  124.     Define_Primitive(P_Weak_Set_Dflt, "weak-set-default!",  2, 2, EVAL);
  125.     }
  126.  
  127.